home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
001
/
pibt40s1.arc
/
GETAUTOF.MOD
< prev
next >
Wrap
Text File
|
1987-03-26
|
2KB
|
61 lines
PROCEDURE Get_Auto_File_Name( Keybrd_Line : AnyStr;
VAR FileName : AnyStr );
VAR
Dot_Pos : INTEGER;
I : INTEGER;
K : INTEGER;
L : INTEGER;
(* STRUCTURED *) CONST
Legal_File_Name_Chars : SET OF CHAR = ['A'..'Z','0'..'9','$','&',
'#','%','''','(',')','-',
'@','^','{','}','~','`',
'!','_'];
BEGIN (* Get_Auto_File_Name *)
(* Null file name to start *)
FileName[0] := #0;
(* No '.' in Keybrd_Line -- *)
(* no file name then, so exit. *)
L := LENGTH( Keybrd_Line );
IF ( L = 0 ) THEN EXIT;
Dot_Pos := POS( '.' , Keybrd_Line );
IF ( Dot_Pos > 0 ) THEN
BEGIN
(* Pick up first part of file name *)
I := Dot_Pos - 1;
K := 8;
WHILE ( ( I > 0 ) AND
( K > 0 ) AND
( UpCase( Keybrd_Line[I] ) IN Legal_File_Name_Chars ) ) DO
BEGIN
FileName := Keybrd_Line[I] + FileName;
I := PRED( I );
K := PRED( K );
END;
(* Insert '.' *)
FileName := FileName + '.';
(* Pick up file extension *)
I := Dot_Pos + 1;
K := 3;
WHILE ( ( I <= L ) AND
( K > 0 ) AND
( UpCase( Keybrd_Line[I] ) IN Legal_File_Name_Chars ) ) DO
BEGIN
FileName := FileName + Keybrd_Line[I];
I := SUCC( I );
K := PRED( K );
END;
END;
END (* Get_Auto_File_Name *);